home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qbsnip.zip / MODEX.BAS < prev    next >
BASIC Source File  |  1997-06-19  |  6KB  |  184 lines
  1. 'Example of how to achieve ModeX in QuickBasic, from Douglas Lusher
  2. 'Modified for DOS' QBASIC by Denis Boyles
  3.  
  4.  DECLARE SUB XCLS (Page%)
  5.  DECLARE SUB ShowPage (Page%)
  6.  DECLARE SUB Set320x240mode ()
  7.  DECLARE SUB XPRINT (X%, Y%, Text$, Culler%, Page%)
  8.  DECLARE SUB PutPixel (X%, Y%, Culler%, Page%)
  9.  DEFINT A-Z
  10. ' '$INCLUDE: 'QB.BI'
  11.  
  12.  DIM BitMask%(7)
  13.  FOR Bit% = 0 TO 7: BitMask%(Bit%) = 2 ^ Bit%: NEXT
  14.  Test$ = "The quick brown fox jumps over lazy dogs"
  15.  CALL XPRINT(0, 0, "", 0, 0)   'initialize the print routine
  16.  
  17.  CALL Set320x240mode: SLEEP 1
  18.  HMax% = 320: VMax% = 240: Pg% = 0
  19.  FOR X% = 0 TO HMax% - 1
  20.    CALL PutPixel(X%, 0, 2, Pg%)
  21.    CALL PutPixel(X%, VMax% - 1, 2, Pg%)
  22.  NEXT
  23.  FOR Y% = 0 TO VMax% - 1
  24.    CALL PutPixel(0, Y%, 2, P%)
  25.    CALL PutPixel(HMax% - 1, Y%, 2, Pg%)
  26.  NEXT
  27.  CALL XPRINT(0, 0, "This is 320x240x256 mode, 3 pages", 15, P%)
  28.  FOR Y% = 1 TO 14
  29.    CALL XPRINT(0, Y% * 16, Test$, Y%, Pg%)
  30.  NEXT
  31.  BEEP: a$ = INPUT$(1)
  32.  CALL XCLS(0)
  33.  CALL XPRINT(0, 0, "This is page 0", 1, 0)
  34.  CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 1, 0)
  35.  CALL XPRINT(0, 80, "Press ESC to exit", 1, 0)
  36.  CALL XPRINT(0, 16, "This is page 1", 2, 1)
  37.  CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 2, 1)
  38.  CALL XPRINT(0, 80, "Press ESC to exit", 2, 1)
  39.  CALL XPRINT(0, 32, "This is page 2", 4, 2)
  40.  CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 4, 2)
  41.  CALL XPRINT(0, 80, "Press ESC to exit", 4, 2)
  42.  DO
  43.  a$ = INPUT$(1)
  44.  SELECT CASE a$
  45.    CASE "0": CALL ShowPage(0)
  46.    CASE "1": CALL ShowPage(1)
  47.    CASE "2": CALL ShowPage(2)
  48.    CASE CHR$(27): EXIT DO
  49.    CASE ELSE: BEEP
  50.  END SELECT
  51.  LOOP
  52.  SCREEN 13: SCREEN 0: WIDTH 80
  53.  END
  54.  
  55.  SUB GetPixel (X%, Y%, Culler%, Page%)
  56.  SELECT CASE Page%
  57.    CASE 0: VidSegment% = &HA000
  58.    CASE 1: VidSegment% = &HA4F0
  59.    CASE 2: VidSegment% = &HA9E0
  60.    CASE ELSE: ERROR 5
  61.  END SELECT
  62.  OUT &H3CE, 4: OUT &H3CF, X% AND 3
  63.  DEF SEG = VidSegment%
  64.  Culler% = PEEK((Y% * 80) + (X% \ 4))
  65.  END SUB
  66.  
  67.  SUB PutPixel (X%, Y%, Culler%, Page%)
  68.  SHARED BitMask%()
  69.  SELECT CASE Page%
  70.    CASE 0: VidSegment% = &HA000
  71.    CASE 1: VidSegment% = &HA4F0
  72.    CASE 2: VidSegment% = &HA9E0
  73.    CASE ELSE: ERROR 5
  74.  END SELECT
  75.  OUT &H3C4, 2: OUT &H3C5, BitMask%(X% AND 3)
  76.  DEF SEG = VidSegment%
  77.  POKE (Y% * 80) + (X% \ 4), Culler%
  78.  END SUB
  79.  
  80.  SUB Set320x240mode
  81.  'begin with standard 320x200x256 mode
  82.  SCREEN 13
  83.  'disable "chain4" mode
  84.  OUT &H3C4, &H4: OUT &H3C5, &H6
  85.  'enable writes to all four planes
  86.  OUT &H3C4, &H2: OUT &H3C5, &HF
  87.  'clear video memory
  88.  CLS
  89.  'synchronous reset while switching clocks
  90.  OUT &H3C4, 0: OUT &H3C5, &H1
  91.  'select 25 Mhz dot clock and 60 hz scanning rate
  92.  OUT &H3C2, &HE3
  93.  'restart the sequencer
  94.  OUT &H3C4, 0: OUT &H3C5, &H3
  95.  'to reprogram the CRT controller,
  96.  'remove write protect from the registers
  97.  OUT &H3D4, &H11: OUT &H3D5, INP(&H3D5) AND &H7F
  98.  OUT &H3D4, &H6: OUT &H3D5, &HD     'total vertical pixels
  99.  OUT &H3D4, &H7: OUT &H3D5, &H3E    'overflow
  100.  OUT &H3D4, &H9: OUT &H3D5, &H41    'turn off double double-scan
  101.  OUT &H3D4, &H10: OUT &H3D5, &HEA   'vertical sync start
  102.  OUT &H3D4, &H11: OUT &H3D5, &HAC   'vertical sync end, reprotect_
  103. ' registers
  104.  OUT &H3D4, &H12: OUT &H3D5, &HDF   'vertical pixels displayed
  105.  OUT &H3D4, &H14: OUT &H3D5, 0      'turn off dword mode
  106.  OUT &H3D4, &H15: OUT &H3D5, &HE7   'vertical blank start
  107.  OUT &H3D4, &H16: OUT &H3D5, &H6    'vertical blank end
  108.  OUT &H3D4, &H17: OUT &H3D5, &HE3   'turn on byte mode
  109.  END SUB
  110.  
  111.  SUB ShowPage (Page%)
  112.  SELECT CASE Page%
  113.    CASE 0: OUT &H3D4, &HC: OUT &H3D5, 0
  114.    CASE 1: OUT &H3D4, &HC: OUT &H3D5, &H4F
  115.    CASE 2: OUT &H3D4, &HC: OUT &H3D5, &H9E
  116.    CASE ELSE: ERROR 5          'illegal function call
  117.  END SELECT
  118.  END SUB
  119.  
  120.  SUB XCLS (Page%)
  121.  SELECT CASE Page%
  122.    CASE 0: VidSegment% = &HA000
  123.    CASE 1: VidSegment% = &HA4F0
  124.    CASE 2: VidSegment% = &HA9E0
  125.    CASE ELSE: ERROR 5
  126.  END SELECT
  127.  OUT &H3C4, &H2: OUT &H3C5, &HF
  128.  DEF SEG = VidSegment%
  129.  FOR Address% = 0 TO 19199: POKE Address%, 0: NEXT
  130.  END SUB
  131.  
  132.  SUB XPRINT (X%, Y%, Text$, Culler%, Page%)
  133.  STATIC HiNibble%(), LoNibble%()
  134.  IF LEN(Text$) GOTO StartXPRINT
  135.  REDIM HiNibble%(255, 15), LoNibble%(255, 15)
  136.  REDIM BitMask%(15)
  137.  BitMask%(0) = 0:  BitMask%(1) = 8:   BitMask%(2) = 4
  138.  BitMask%(3) = 12: BitMask%(4) = 2:   BitMask%(5) = 10
  139.  BitMask%(6) = 6:  BitMask%(7) = 14:  BitMask%(8) = 1
  140.  BitMask%(9) = 9:  BitMask%(10) = 5:  BitMask%(11) = 13
  141.  BitMask%(12) = 3: BitMask%(13) = 11: BitMask%(14) = 7
  142.  BitMask%(15) = 15
  143.  'DIM Regs AS RegTypeX
  144.  Regs.AX = &H1130
  145.  Regs.BX = &H600
  146.  'CALL InterruptX(&H10, Regs, Regs)
  147.  'CharSegment% = Regs.ES: CharOffset% = Regs.BP
  148.  CharSegment% = &HF000: CharOffset% = &HFA6E
  149.  DEF SEG = CharSegment%
  150.  FOR Char% = 0 TO 127
  151.    FOR Ln% = 0 TO 7
  152.      BitPattern% = PEEK(CharOffset%)
  153.      HiNibble%(Char%, Ln%) = BitMask%(BitPattern% \ 16)
  154.      LoNibble%(Char%, Ln%) = BitMask%(BitPattern% AND 15)
  155.      CharOffset% = CharOffset% + 1
  156.    NEXT
  157.  NEXT
  158.  ERASE BitMask%
  159.  
  160. StartXPRINT:
  161.  SELECT CASE Page%
  162.    CASE 0: VidSegment% = &HA000
  163.    CASE 1: VidSegment% = &HA4F0
  164.    CASE 2: VidSegment% = &HA9E0
  165.    CASE ELSE: ERROR 5
  166.  END SELECT
  167.  OUT &H3C4, 2
  168.  DEF SEG = VidSegment%
  169.  VidPtr% = (Y% * 80) + (X% \ 4)
  170.  FOR Ptr% = 1 TO LEN(Text$)
  171.    Char% = ASC(MID$(Text$, Ptr%, 1))
  172.    VidOffset% = VidPtr%
  173.    FOR Ln% = 0 TO 15
  174.      OUT &H3C5, HiNibble%(Char%, Ln%)
  175.      POKE VidOffset%, Culler%
  176.      OUT &H3C5, LoNibble%(Char%, Ln%)
  177.      POKE VidOffset% + 1, Culler%
  178.      VidOffset% = VidOffset% + 80
  179.    NEXT
  180.    VidPtr% = VidPtr% + 2
  181.  NEXT
  182.  END SUB
  183.  
  184.